home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Software Vault: The Gold Collection
/
Software Vault - The Gold Collection (American Databankers) (1993).ISO
/
cdr14
/
maped7.zip
/
MAPEDIT.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-06-19
|
62KB
|
2,113 lines
{
MapEdit 7.0 Wolfenstein Map Editor
ver 7.0 (Bryan Baker, Dave Huntoon - 6/93)
- Added options to only display certain level guards,
treasure, or ammo & food
These options are:
'1' - Level 1 Guards Only
'2' - Treasure and One-ups Only
'3' - Level 3 Guards Only
'4' - Level 4 Guards Only
'5' - Boss Guards Only
'6' - Ammo, Food, First Aid, and One-ups only
- Added filename prompt to Read and Write floor files
- Improved program startup and error display. Simplified
file opening logic. This will make installation easier and
almost fool proof.
- Modified Legend to display only those items in the MAPDATA and
OBJDATA files and in the order read from the files.
- Minor bug fixes
ver 6.1 (Matt Gruson - 5/93 Contact on CompuServe @ 72360,2432 or
73766,347
Prodigy @ PTJT50A
GEnie @ M.GRUSON
- Allowed right mouse button to have it's own value.
- Allowed sepperate tracking of MAP and OBJ mode values for
the different mouse buttons.
- Holding down shift key while clicking on the map loads values.
- Spacebar toggles between MAP and OBJECT modes.
- Allowed PAGEUP and PAGEDOWN to scroll the legend display.
- Removed unused code for clarity.
ver 6.0 (Dave Huntooon - 5/93)
- Added help display (and switch to toggle help / stats)
- Added Copy, Paste and Exchange procedures
- Added Write and Read procedures that will allow
exporting and importing floors via a file named
FLOOR.OUT
- Changed the Clear procedure to fill using the
currently selected map value
- minor fixes
ver 5.0 (Bryan Baker - 4/93)
- Added display of critical map statistics to edit window:
Static Objects
Total Guards
Doors
Level 1 Guards
Level 3 Guards
Level 4 Guards
Super Guards
Secret Doors
Treasure & Extra Lives
ver 4.1a (Dave Huntoon)
- Adds ability to open Spear of Destiny (SOD) maps.
- Allows access to objects > 00FE. Needed for SOD objects
- minor fix to completely clear text area below
the map display when the mouse is moved outside
of the map area.
ver 4.1 Copyright (c) 1992 Bill Kirby
}
{$A+,B-,D+,E-,F-,I+,L-,N-,O-,R-,S-,V-}
{$M 16384,0,655360}
program mapedit;
uses crt,dos,graph,mouse;
const MAP_X = 6;
MAP_Y = 6;
TEXTLOC = 458;
GAMEPATH : string = '.\';
LEVELS : word = 10;
GAME_VERSION : real = 1.0;
VERSION : string = '7.0';
KEYSTATADDR = $417;
LEFTSHIFTMASK = $01;
RIGHTSHIFTMASK = $02;
{Rev 6.1}
KEY_PGUP = chr(73);
KEY_PGDN = chr(81); {These should be CHARs, but since Borland
Pascal 7 can't evaluate CHAR constants in
case statements I had to do it the ugly way}
type data_block = record
size : word;
data : pointer;
end;
level_type = record
map,
objects,
other : data_block;
width,
height : word;
name : string[16];
end;
grid = array[0..63,0..63] of word;
filltype = (solid,check);
doortype = (horiz,vert);
var levelmap,
objectmap : grid;
maps : array[1..60] of level_type;
show_objects,
show_floor,
guards_1,
guards_3,
guards_4,
guards_s,
treasure,
ammofood : boolean;
mapgraph,
objgraph : array[0..300] of string[4];
mapnames,
objnames : array[0..300] of string[20];
legmapptr, legobjptr : array[0..300] of word;
mapcount, objcount : integer;
themouse : resetrec;
mouseloc : locrec;
MAPFILENAME : string [12];
HEADFILENAME : string [12];
stats,
xfer,
copy,
excng : boolean;
tempobj,
tempmap : grid;
procedure decorate(x, y, c: integer);
var i, j: integer;
begin
setfillstyle(1, c);
bar(x*7+MAP_X+2, y*7+MAP_Y+2, x*7+MAP_X+4, y*7+MAP_Y+4);
end;
procedure box(fill: filltype; x, y, c1, c2: integer; dec: boolean);
begin
if fill=solid then
setfillstyle(1, c1)
else
setfillstyle(9, c1);
bar(x*7+MAP_X, y*7+MAP_Y, x*7+6+MAP_X, y*7+6+MAP_Y);
if dec then decorate(x,y,c2);
end;
procedure outtext(x, y, color: integer; s: string);
begin
setcolor(color);
outtextxy(x*7+MAP_X, y*7+MAP_Y, s);
end;
function hex(x: word): string;
const digit : string[16] = '0123456789ABCDEF';
var temp : string[4];
i : integer;
begin
temp := ' ';
for i := 4 downto 1 do
begin
temp[i] := digit[(x and $000f) + 1];
x := x div 16;
end;
hex := temp;
end;
function hexbyte(x: byte): string;
const digit : string[16] = '0123456789ABCDEF';
var temp : string[4];
i : integer;
begin
temp := ' ';
for i := 2 downto 1 do
begin
temp[i] := digit[(x and $000f) + 1];
x := x div 16;
end;
hexbyte := temp;
end;
procedure doline(x, y, x2, y2: integer);
begin
line(x+MAP_X, y+MAP_Y, x2+MAP_X, y2+MAP_Y);
end;
procedure dobar(x, y, x2, y2: integer);
begin
bar(x+MAP_Y, y+MAP_Y, x2+MAP_X, y2+MAP_Y);
end;
procedure circle(x, y, c1, c2: integer);
const sprite : array[0..6,0..6] of byte =
((0,0,1,1,1,0,0),
(0,1,1,1,1,1,0),
(1,1,1,2,1,1,1),
(1,1,2,2,2,1,1),
(1,1,1,2,1,1,1),
(0,1,1,1,1,1,0),
(0,0,1,1,1,0,0));
var i, j, c: integer;
begin
for i := 0 to 6 do
for j := 0 to 6 do
begin
case sprite[i, j] of
0: c := 0;
1: c := c1;
2: c := c2;
end;
putpixel(x*7+MAP_X+i, y*7+MAP_Y+j, c);
end;
end;
procedure door(dtype: doortype; x, y, color: integer);
begin
case dtype of
vert : begin
setfillstyle(1, color);
dobar(x*7+2, y*7, x*7+4, y*7+6);
end;
horiz : begin
setfillstyle(1, color);
dobar(x*7, y*7+2, x*7+6, y*7+4);
end;
end;
end;
function hexnibble(c: char): byte;
begin
case c of
'0'..'9': hexnibble := ord(c) - ord('0');
'a'..'f': hexnibble := ord(c) - ord('a') + 10;
'A'..'F': hexnibble := ord(c) - ord('A') + 10;
else hexnibble := 0;
end;
end;
procedure output(x, y: integer; data: string);
var size : integer;
temp : string[4];
c1, c2 : byte;
begin
if data<>'0000' then
begin
temp := data;
c1 := hexnibble(temp[1]);
c2 := hexnibble(temp[2]);
case temp[3] of
'0': outtext(x, y, c1, temp[4]);
'1': box(solid, x, y, c1, c2, false);
'2': box(check, x, y, c1, c2, false);
'3': box(solid, x, y, c1, c2, true);
'4': box(check, x, y, c1, c2, true);
'5': circle(x, y, c1, c2);
'6': door(horiz, x, y, c1);
'7': door(vert, x, y, c1);
'8': begin
setfillstyle(1, c1);
dobar(x*7, y*7, x*7+6, y*7+3);
setfillstyle(1, c2);
dobar(x*7, y*7+4, x*7+6, y*7+6);
end;
'9': putpixel(x*7+MAP_X+3, y*7+MAP_Y+3, c1);
'a': begin
setfillstyle(1, c1);
dobar(x*7+2, y*7+1, x*7+4, y*7+5);
end;
'b': begin
setfillstyle(1, c1);
dobar(x*7+2, y*7+2, x*7+4, y*7+4);
end;
'c': begin
setfillstyle(1, c1);
dobar(x*7+1, y*7+1, x*7+5, y*7+5);
end;
'd': begin
setcolor(c1);
doline(x*7+1, y*7+1, x*7+5, y*7+5);
doline(x*7+5, y*7+1, x*7+1, y*7+5);
end;
'e': begin
setcolor(c1);
rectangle(x*7+MAP_X, y*7+MAP_Y, x*7+MAP_X+6, y*7+MAP_Y+6);
end;
'f': case c2 of
2: begin {east}
setcolor(c1);
doline(x*7, y*7+3, x*7+6, y*7+3);
doline(x*7+6, y*7+3, x*7+3, y*7);
doline(x*7+6, y*7+3, x*7+3, y*7+6);
end;
0: begin {north}
setcolor(c1);
doline(x*7+3, y*7+6, x*7+3, y*7);
doline(x*7+3, y*7, x*7, y*7+3);
doline(x*7+3, y*7, x*7+6, y*7+3);
end;
6: begin {west}
setcolor(c1);
doline(x*7+6, y*7+3, x*7, y*7+3);
doline(x*7, y*7+3, x*7+3, y*7);
doline(x*7, y*7+3, x*7+3, y*7+6);
end;
4: begin {south}
setcolor(c1);
doline(x*7+3, y*7, x*7+3, y*7+6);
doline(x*7+3, y*7+6, x*7, y*7+3);
doline(x*7+3, y*7+6, x*7+6, y*7+3);
end;
1: begin {northeast}
setcolor(c1);
doline(x*7, y*7+6, x*7+6, y*7);
doline(x*7+6, y*7, x*7+3, y*7);
doline(x*7+6, y*7, x*7+6, y*7+3);
end;
7: begin {northwest}
setcolor(c1);
doline(x*7+6, y*7+6, x*7, y*7);
doline(x*7, y*7, x*7+3, y*7);
doline(x*7, y*7, x*7, y*7+3);
end;
3: begin {southeast}
setcolor(c1);
doline(x*7, y*7, x*7+6, y*7+6);
doline(x*7+6, y*7+6, x*7+3, y*7+6);
doline(x*7+6, y*7+6, x*7+6, y*7+3);
end;
5: begin {southwest}
setcolor(c1);
doline(x*7+6, y*7, x*7, y*7+6);
doline(x*7, y*7+6, x*7+3, y*7+6);
doline(x*7 , y*7+6, x*7, y*7+3);
end;
end;
end;
end;
end;
procedure display_map;
var i, j : integer;
disp_obj : word;
begin
j := 63;
i := 0;
repeat
setfillstyle(1, 0);
dobar(i*7, j*7, i*7+6, j*7+6);
if show_floor then
output(i, j, mapgraph[levelmap[i,j]]) {Show everything}
else
if not (levelmap[i,j] in [$6a..$8f]) then
output(i,j,mapgraph[levelmap[i,j]]); {Show walls & doors}
if show_objects then
begin {Show objects}
disp_obj := objectmap[i,j];
if (guards_1 and (disp_obj in [$6c..$7c,$7c..$85,$8a..$8d,$d8..$df]))
then output(i, j, objgraph[disp_obj]);
if (guards_3 and (disp_obj in [$90..$9f,$a2..$a9,$ae..$b1,$ea..$f1]))
then output(i, j, objgraph[disp_obj]);
if (guards_4 and (disp_obj in [$b4..$c3,$c6..$cd,$d2..$d5]))
then output(i, j, objgraph[disp_obj]);
if (guards_4 and (disp_obj>$fb) and (disp_obj<$104))
then output(i, j, objgraph[disp_obj]);
if (guards_s and (disp_obj in [$c4,$c5,$d6,$d7,$e0..$e3,$6a,$6b,$8e,$8f,$a0,$a1,$b2,$b3,$7d]))
then output(i, j, objgraph[disp_obj]);
if (treasure and (disp_obj in [$34..$38]))
then output(i, j, objgraph[disp_obj]);
if (ammofood and (disp_obj in [$2f,$30..$33,$38,$48,$1d]))
then output(i, j, objgraph[disp_obj]);
if not(guards_1 or guards_3 or guards_4 or guards_s or treasure or ammofood)
then output(i, j, objgraph[disp_obj]);
end;
inc(i);
if i=64 then
begin
i := 0;
dec(j);
end;
until (j<0) or keypressed;
end;
procedure read_levels;
var headfile,
mapfile : file;
s,o,
size : word;
idsig : string[4];
level : integer;
levelptr : longint;
tempstr : string[16];
map_pointer,
object_pointer,
other_pointer : longint;
begin
idsig := ' ';
tempstr := ' ';
assign(headfile,GAMEPATH+HEADFILENAME);
{$I-} reset(headfile, 1); {$I+}
if ioresult<>0 then
begin
writeln('error opening ',HEADFILENAME);
halt(1);
end;
assign(mapfile,GAMEPATH+MAPFILENAME);
{$I-} reset(mapfile, 1); {$I+}
if ioresult<>0 then
begin
writeln('error opening ',MAPFILENAME);
halt(1);
end;
for level:= 1 to LEVELS do
begin
seek(headfile, 2+(level-1)*4);
blockread(headfile, levelptr, 4);
seek(mapfile, levelptr);
with maps[level] do
begin
blockread(mapfile, map_pointer, 4);
blockread(mapfile, object_pointer, 4);
blockread(mapfile, other_pointer, 4);
blockread(mapfile, map.size, 2);
blockread(mapfile, objects.size, 2);
blockread(mapfile, other.size, 2);
blockread(mapfile, width, 2);
blockread(mapfile, height, 2);
name[0] := #16;
blockread(mapfile, name[1], 16);
if GAME_VERSION=1.1 then
blockread(mapfile, idsig[1], 4);
seek(mapfile, map_pointer);
getmem(map.data, map.size);
s := seg(map.data^);
o := ofs(map.data^);
blockread(mapfile, mem[s:o], map.size);
seek(mapfile, object_pointer);
getmem(objects. data,objects.size);
s := seg(objects.data^);
o := ofs(objects.data^);
blockread(mapfile, mem[s:o], objects.size);
seek(mapfile, other_pointer);
getmem(other.data, other.size);
s := seg(other.data^);
o := ofs(other.data^);
blockread(mapfile, mem[s:o], other.size);
if GAME_VERSION=1.0 then
blockread(mapfile, idsig[1], 4);
end;
end;
close(mapfile);
close(headfile);
end;
procedure write_levels;
var headfile,
mapfile : file;
abcd,
s,o,
size : word;
idsig : string[4];
level : integer;
levelptr : longint;
tempstr : string[16];
map_pointer,
object_pointer,
other_pointer : longint;
begin
abcd := $abcd;
idsig := '!ID!';
tempstr := 'TED5v1.0';
assign(headfile, GAMEPATH+HEADFILENAME);
rewrite(headfile, 1);
assign(mapfile, GAMEPATH+MAPFILENAME);
rewrite(mapfile, 1);
blockwrite(headfile, abcd, 2);
blockwrite(mapfile, tempstr[1], 8);
levelptr := 8;
for level:=1 to LEVELS do
begin
with maps[level] do
begin
if GAME_VERSION=1.1 then
begin
map_pointer := levelptr;
s := seg(map.data^);
o := ofs(map.data^);
blockwrite(mapfile, mem[s:o], map.size);
inc(levelptr, map.size);
object_pointer := levelptr;
s := seg(objects.data^);
o := ofs(objects.data^);
blockwrite(mapfile, mem[s:o], objects.size);
inc(levelptr, objects.size);
other_pointer := levelptr;
s := seg(other.data^);
o := ofs(other.data^);
blockwrite(mapfile, mem[s:o], other.size);
inc(levelptr, other.size);
blockwrite(headfile, levelptr, 4);
blockwrite(mapfile, map_pointer, 4);
blockwrite(mapfile, object_pointer, 4);
blockwrite(mapfile, other_pointer, 4);
blockwrite(mapfile, map.size, 2);
blockwrite(mapfile, objects.size, 2);
blockwrite(mapfile, other.size, 2);
blockwrite(mapfile, width, 2);
blockwrite(mapfile, height, 2);
name[0] := #16;
blockwrite(mapfile, name[1], 16);
inc(levelptr, 38);
end
else
begin
blockwrite(headfile, levelptr, 4);
map_pointer := levelptr+38;
object_pointer := map_pointer+map.size;
other_pointer := object_pointer+objects.size;
blockwrite(mapfile, map_pointer, 4);
blockwrite(mapfile, object_pointer, 4);
blockwrite(mapfile, other_pointer, 4);
blockwrite(mapfile, map.size, 2);
blockwrite(mapfile, objects.size, 2);
blockwrite(mapfile, other.size, 2);
blockwrite(mapfile, width, 2);
blockwrite(mapfile, height, 2);
name[0] := #16;
blockwrite(mapfile, name[1], 16);
s := seg(map.data^);
o := ofs(map.data^);
blockwrite(mapfile, mem[s:o], map.size);
s := seg(objects.data^);
o := ofs(objects.data^);
blockwrite(mapfile, mem[s:o], objects.size);
s := seg(other.data^);
o := ofs(other.data^);
blockwrite(mapfile, mem[s:o], other.size);
inc(levelptr, map.size+objects.size+other.size+38);
end;
blockwrite(mapfile, idsig[1], 4);
inc(levelptr, 4);
end;
end;
close(mapfile);
close(headfile);
end;
procedure a7a8_expand(src: data_block; var dest: data_block);
var s, o,
s2, o2,
index, index2,
size,
length,
data,
newsize : word;
goback1 : byte;
goback2 : word;
i : integer;
begin
s := seg(src.data^);
o := ofs(src.data^);
index := 0;
move(mem[s:o+index], dest.size, 2);
inc(index, 2);
getmem(dest.data, dest.size);
s2 := seg(dest.data^);
o2 := ofs(dest.data^);
index2 := 0;
repeat
move(mem[s:o+index], data, 2);
inc(index, 2);
case hi(data) of
$a7: begin
length := lo(data);
move(mem[s:o+index], goback1, 1);
inc(index, 1);
move(mem[s2:o2+index2-goback1*2], mem[s2:o2+index2], length*2);
inc(index2,length*2);
end;
$a8: begin
length := lo(data);
move(mem[s:o+index], goback2, 2);
inc(index, 2);
move(mem[s2:o2+goback2*2], mem[s2:o2+index2], length*2);
inc(index2, length*2);
end;
else begin
move(data, mem[s2:o2+index2], 2);
inc(index2, 2);
end;
end;
until index=src.size;
end;
procedure expand(d: data_block; var g: grid);
var i,x,y : integer;
s,o,
data,
count : word;
temp : data_block;
begin
if GAME_VERSION = 1.1 then
a7a8_expand(d, temp)
else
temp := d;
x := 0;
y := 0;
s := seg(temp.data^);
o := ofs(temp.data^);
inc(o, 2);
while (y<64) do
begin
move(mem[s:o], data, 2);
inc(o, 2);
if data=$abcd then
begin
move(mem[s:o], count, 2);
inc(o, 2);
move(mem[s:o], data, 2);
inc(o, 2);
for i:=1 to count do
begin
g[x,y] := data;
inc(x);
if x=64 then
begin
x := 0;
inc(y);
end;
end;
end
else
begin
g[x,y] := data;
inc(x);
if x=64 then
begin
x := 0;
inc(y);
end;
end;
end;
if GAME_VERSION=1.1 then
freemem(temp.data, temp.size);
end;
procedure compress(g: grid; var d: data_block);
var temp : pointer;
size : word;
abcd,
s,o,
olddata,
data,
nextdata,
count : word;
x,y,i : integer;
temp2 : pointer;
begin
abcd := $abcd;
x := 0;
y := 0;
getmem(temp, 8194);
s := seg(temp^);
o := ofs(temp^);
data := $2000;
move(data, mem[s:o], 2);
size := 2;
data := g[0,0];
while (y<64) do
begin
count := 1;
repeat
inc(x);
if x=64 then
begin
x :=0;
inc(y);
end;
if y<64 then
nextdata:= g[x,y];
inc(count);
until (nextdata<>data) or (y=64);
dec(count);
if count<3 then
begin
for i:= 1 to count do
begin
move(data, mem[s:o+size], 2);
inc(size, 2);
end;
end
else
begin
move(abcd, mem[s:o+size], 2);
inc(size, 2);
move(count, mem[s:o+size], 2);
inc(size, 2);
move(data, mem[s:o+size], 2);
inc(size, 2);
end;
data := nextdata;
end;
getmem(temp2, size);
move(temp^, temp2^, size);
freemem(temp, 8194);
if GAME_VERSION=1.1 then
begin
getmem(temp, size+2);
s := seg(temp^);
o := ofs(temp^);
move(size, mem[s:o], 2);
move(temp2^, mem[s:o+2], size);
d.data := temp;
d.size := size+2;
freemem(temp2, size);
end
else
begin
d.data := temp2;
d.size := size;
end;
end;
procedure copy_level; { DGH 5/93 }
begin
tempobj := objectmap;
tempmap := levelmap;
end;
procedure paste_level; { DGH 5/93 }
begin
objectmap := tempobj;
levelmap := tempmap;
end;
procedure exchange; { DGH 5/93 }
var i, j : integer;
tempobj1,
tempmap1 : word;
begin
for i:=0 to 63 do
for j:=0 to 63 do
begin
tempobj1 := objectmap[i,j];
tempmap1 := levelmap[i,j];
objectmap[i,j] := tempobj[i,j];
levelmap[i,j] := tempmap[i,j];
tempobj[i,j] := tempobj1;
tempmap[i,j] := tempmap1;
end;
end;
procedure print_help; {DGH 5/93 }
var StartX : integer;
StartY : integer;
DeltaY : integer;
begin
StartX := MAP_X+462;
StartY := MAP_Y+380;
DeltaY := 9;
setcolor(15);
setfillstyle(1,0);
bar(StartX, StartY, 639, 479);
outtextxy(StartX, StartY, 'O = Toggle Objects');
StartY := StartY + DeltaY;
outtextxy(StartX, StartY, 'F = Toggle Floor');
StartY := StartY + DeltaY;
outtextxy(StartX, StartY, 'C = Clear Floor');
StartY := StartY + DeltaY;
outtextxy(StartX, StartY, 'S = Toggle Stats/Help');
StartY := StartY + DeltaY;
if copy then setcolor(14) else setcolor(15);
outtextxy(StartX, StartY, 'M = Memorize Level');
StartY := StartY + DeltaY;
if (excng and copy) then setcolor(14);
if (excng and not copy) then setcolor (12);
if not excng then setcolor(15);
outtextxy(StartX, StartY, 'E = Exchange Level');
setcolor(15);
if (not copy and xfer) then setcolor(12);
if (copy and xfer) then setcolor(14);
StartY := StartY + DeltaY;
outtextxy(StartX, StartY, 'T = Transfer Level');
setcolor(15);
StartY := StartY + DeltaY;
outtextxy(startx, starty, 'R = Read floor file');
StartY := StartY + DeltaY;
outtextxy(startx, starty, 'W = Write floor file');
StartY := StartY + DeltaY;
outtextxy(startx, starty, 'SPACE = Toggle mode');
StartY := StartY + DeltaY;
outtextxy(StartX, StartY, 'Q = Quit');
delay(200);
end;
procedure print_version; { DGH 5/93 }
begin
setfillstyle(1,0);
bar(180, TEXTLOC, 461, 479);
setcolor(12);
outtextxy(188, TEXTLOC, 'Mapedit v'+VERSION);
end;
procedure get_filename(var filename: string); { BDB 6/93 }
var FnCount,
ExtCount,
TotalCount,
ColumnPtr : integer;
key : char;
Done : boolean;
begin
setfillstyle(1,0);
bar(MAP_X, MAP_Y, MAP_X+448, MAP_Y+448);
setcolor(15);
outtextxy(MAP_X, MAP_Y,'Enter filename: (Press ESC to abort)');
FnCount := 0;
ExtCount := -1;
TotalCount := 0;
filename := '';
ColumnPtr := MAP_X;
Done := false;
repeat
repeat
outtextxy(ColumnPtr, MAP_Y+10, #95);
repeat until keypressed;
setcolor(0);
outtextxy(ColumnPtr, MAP_Y+10, #219);
setcolor(15);
key := readkey;
if key=#0 then
begin
key := readkey;
key := #0;
end;
until key in ['0'..'9','A'..'Z','a'..'z', #08, #13, #27, #46];
if ((key=#13) or (key=#27)) then Done := true { CR or ESC }
else
begin
if (key=#08) then { Backspace }
begin
if TotalCount>0 then
begin
delete(filename, TotalCount, 1);
if ExtCount>=0 then ExtCount := ExtCount - 1
else FnCount := FnCount - 1;
ColumnPtr := ColumnPtr - 8;
setcolor(0);
outtextxy(ColumnPtr, MAP_Y+10, #219);
setcolor(15);
end
end
else if TotalCount<12 then
if (((key=#46) and (ExtCount<0) and (FnCount>0)) or
((key<>#46) and not((FnCount=8) and (ExtCount<0)) and (ExtCount<3)))
then begin
filename := filename + key;
outtextxy(ColumnPtr, MAP_Y+10, key);
ColumnPtr := ColumnPtr + 8;
if (key=#46) then ExtCount := ExtCount + 1
else if ExtCount >= 0 then ExtCount := ExtCount + 1
else FnCount := FnCount + 1;
end;
TotalCount := FnCount + ExtCount + 1;
end;
until Done;
if key=#27 then filename := 'ABORT';
end;
procedure error_read(ecode : integer); { DGH 5/93 ; BDB 6/93 }
var temp : string[3];
begin
str(ecode, temp);
outtextxy(MAP_X, MAP_Y+50, 'Error reading floor file.');
end;
procedure error_write(ecode : integer); { DGH 5/93 ; BDB 6/93 }
var temp : string[3];
begin
str(ecode, temp);
outtextxy(MAP_X, MAP_Y+50, 'Error writing floor file.');
end;
procedure read_floor; { DGH 5/93 ; BDB 6/93 }
var floor_file : file;
numread1 : word;
numread2 : word;
size : word;
filename : string[12];
key : char;
ior : integer;
begin
get_filename(filename);
if filename<>'ABORT' then
begin
size := sizeof(tempmap);
Assign(floor_file, filename);
{$I-} reset(floor_file,1); {$I+}
ior := ioresult;
if ior <> 0 then error_read(ior)
else
begin
blockread(floor_file, tempmap, sizeof(tempmap), numread1);
blockread(floor_file, tempobj, sizeof(tempmap), numread2);
if (numread1<>size) or (numread2<>size) then error_read(999)
else
begin
copy := true;
outtextxy(MAP_X, MAP_Y+50, 'Floor file read. Use "E" or "T" command to insert.');
end;
close(floor_file);
end;
outtextxy(MAP_X, MAP_Y+70, 'Press any key to continue . . .');
repeat until keypressed;
key := readkey;
end;
print_help;
display_map;
end;
procedure write_floor; { DGH 5/93 ; BDB 6/93 }
var floor_file : file;
numwrite1 : word;
numwrite2 : word;
size : word;
filename : string[12];
key : char;
ior : integer;
begin
get_filename(filename);
if filename<>'ABORT' then
begin
size := sizeof(tempmap);
Assign(floor_file, filename);
{$I-} rewrite(floor_file,1); {$I+}
ior := ioresult;
if ior <> 0 then error_write(ior)
else
begin
blockwrite(floor_file, levelmap, sizeof(levelmap), numwrite1);
blockwrite(floor_file, objectmap, sizeof(objectmap), numwrite2);
if (numwrite1<>size) or (numwrite2<>size) then error_write(999);
close(floor_file);
outtextxy(MAP_X, MAP_Y+50, 'Floor file written.');
end;
outtextxy(MAP_X, MAP_Y+70, 'Press any key to continue . . .');
repeat until keypressed;
key := readkey;
end;
display_map;
end;
procedure print_stats; { BDB 4/93 }
var i, j : integer;
Tempstr : string;
Statics : integer;
L1Guards : integer;
L3Guards : integer;
L4Guards : integer;
SGuards : integer;
TGuards : integer;
Prizes : integer;
Doors : integer;
SecDoors : integer;
StartX : integer;
StartY : integer;
DeltaY : integer;
begin
if stats then
begin
Statics := 0;
L1Guards := 0;
L3Guards := 0;
L4Guards := 0;
SGuards := 0;
TGuards := 0;
Prizes := 0;
Doors := 0;
SecDoors := 0;
StartX := MAP_X+462;
StartY := MAP_Y+380;
DeltaY := 9;
for i:=0 to 63 do
for j:=0 to 63 do
begin
if objectmap[i,j] in [$17..$4a]
then Statics := Statics+1;
if objectmap[i,j] in [$6c..$7c,$7e..$85,$8a..$8d,$d8..$df]
then L1Guards := L1Guards+1;
if objectmap[i,j] in [$90..$9f,$a2..$a9,$ae..$b1,$ea..$f1]
then L3Guards := L3Guards+1;
if objectmap[i,j] in [$b4..$c3,$c6..$cd,$d2..$d5]
then L4Guards := L4Guards+1;
if (objectmap[i,j]>$fb) and (objectmap[i,j]<$104)
then L4Guards := L4Guards+1;
if objectmap[i,j] in [$c4,$c5,$d6,$d7,$e0..$e3,$6a,$6b,$8e,$8f,$a0,$a1,$b2,$b3,$7d]
then SGuards := SGuards+1;
if objectmap[i,j] in [$34..$38]
then Prizes := Prizes+1;
if objectmap[i,j] = $62
then SecDoors := SecDoors+1;
if levelmap[i, j] in [$5a..$5f,$64..$65]
then Doors := Doors+1;
end;
TGuards := L1Guards + L3Guards + L4Guards + SGuards;
setcolor(15);
setfillstyle(1,0);
bar(StartX, StartY, 639, 479);
if Statics<400 then setcolor(15) else setcolor(12);
str(Statics:4, Tempstr);
outtextxy(StartX, StartY,Tempstr+' Static Objects');
if TGuards<150 then setcolor(15) else setcolor(12);
StartY := StartY + DeltaY;
str(TGuards:4, Tempstr);
outtextxy(StartX, StartY,Tempstr+' Total Guards ');
if Doors<65 then setcolor(15) else setcolor(12);
StartY := StartY + DeltaY;
str(Doors:4, Tempstr);
outtextxy(StartX, StartY,Tempstr+' Doors ');
if guards_1 then setcolor(14) else setcolor(7);
StartY := StartY + DeltaY + 4;
str(L1Guards:4, Tempstr);
outtextxy(StartX, StartY,Tempstr+' Level 1 Guards');
if guards_3 then setcolor(14) else setcolor(7);
StartY := StartY + DeltaY;
str(L3Guards:4, Tempstr);
outtextxy(StartX, StartY,Tempstr+' Level 3 Guards');
if guards_4 then setcolor(14) else setcolor(7);
StartY := StartY + DeltaY;
str(L4Guards:4, Tempstr);
outtextxy(StartX, StartY,Tempstr+' Level 4 Guards');
if guards_s then setcolor(14) else setcolor(7);
StartY := StartY + DeltaY;
str(SGuards:4, Tempstr);
outtextxy(StartX, StartY,Tempstr+' Super Guards');
setcolor(7);
StartY := StartY + DeltaY + 4;
str(SecDoors:4, Tempstr);
outtextxy(StartX, StartY,Tempstr+' Secret Doors ');
if treasure then setcolor(14) else setcolor(7);
StartY := StartY + DeltaY;
str(Prizes:4, Tempstr);
outtextxy(StartX, StartY,Tempstr+' $$$ / One-ups ');
end;
end;
procedure clear_level(n: integer);
var x,y: integer;
begin
mhide;
for x:=0 to 63 do
for y:=0 to 63 do
begin
levelmap[x,y] := n;
objectmap[x,y] := 0;
end;
for x:=0 to 63 do
begin
levelmap[x,0] := 1;
levelmap[x,63] := 1;
levelmap[0,x] := 1;
levelmap[63,x] := 1;
end;
display_map;
print_stats;
mshow;
end;
function str_to_hex(s: string): word;
var temp : word;
i : integer;
begin
temp := 0;
for i:=1 to length(s) do
begin
temp := temp * 16;
case s[i] of
'0'..'9': temp := temp + ord(s[i]) - ord('0');
'a'..'f': temp := temp + ord(s[i]) - ord('a')+10;
'A'..'F': temp := temp + ord(s[i]) - ord('A')+10;
end;
end;
str_to_hex := temp;
end;
procedure showlegend(which, start, n: integer);
var i,x,y : integer;
save : boolean;
begin
mhide;
save := show_objects;
show_objects := true;
setfillstyle(1,0);
bar(MAP_X+461, 4, 634, 350);
x := 66;
y := 0;
for i:=start to start+n-1 do
begin
if which=0 then
begin
output(x, y, mapgraph[legmapptr[i]]);
outtext(x+2, y, 15, mapnames[legmapptr[i]]);
end
else
begin
output(x, y, objgraph[legobjptr[i]]);
outtext(x+2, y, 15, objnames[legobjptr[i]]);
end;
inc(y, 2);
end;
show_objects := save;
mshow;
end;
function inside(x1, y1, x2, y2, x, y: integer): boolean;
begin
inside := (x>=x1) and (x<=x2) and (y>=y1) and (y<=y2);
end;
procedure wait_for_mouserelease;
begin
repeat
mpos(mouseloc);
until mouseloc.buttonstatus=0;
end;
procedure bevel(x1, y1, x2, y2, c1, c2, c3: integer);
begin
setfillstyle(1,c1);
bar(x1, y1, x2, y2);
setcolor(c2);
line(x1, y1, x2, y1);
line(x1+1, y1+1, x2-1, y1+1);
line(x2, y1, x2, y2);
line(x2-1, y1, x2-1, y2-1);
setcolor(c3);
line(x1, y1+1, x1, y2);
line(x1+1, y1+2, x1+1, y2);
line(x1, y2, x2-1, y2);
line(x1+1, y2-1, x2-2, y2-1);
end;
function upper(s: string): string;
var i: integer;
begin
for i:=1 to length(s) do
if s[i] in ['a'..'z'] then
s[i] := chr(ord(s[i]) - ord('a') + ord('A'));
upper := s;
end;
procedure initialize;
var i : integer;
infile : text;
path : pathstr;
dir : dirstr;
name : namestr;
ext : extstr;
filename : string;
hexstr : string[4];
graphstr : string[4];
name20 : string[20];
junk : char;
search : searchrec;
map : string[12];
obj : string[12];
sod,
wl1,
wl6 : boolean;
begin
writeln('MapEdit Copyright (c) 1992 Bill Kirby');
writeln('Version '+version);
writeln;
writeln('Modifications by Dave Huntoon');
writeln(' Bryan Baker');
writeln(' Matt Gruson');
writeln;
MAPFILENAME := 'maptemp.wl1';
filename := GAMEPATH + MAPFILENAME ;
findfirst(filename, $ff, search);
if doserror=0 then
writeln('Found --> '+MAPFILENAME);
if doserror<>0 then
begin
MAPFILENAME := 'gamemaps.wl1';
filename := GAMEPATH + MAPFILENAME ;
findfirst(filename, $ff, search);
if doserror=0 then
writeln('Found --> '+MAPFILENAME);
if doserror<>0 then
begin
MAPFILENAME := 'gamemaps.wl3';
filename := GAMEPATH + MAPFILENAME ;
findfirst(filename, $ff, search);
if doserror=0 then
writeln('Found --> '+MAPFILENAME);
if doserror<>0 then
begin
MAPFILENAME := 'gamemaps.wl6';
filename := GAMEPATH + MAPFILENAME ;
findfirst(filename, $ff, search);
if doserror=0 then
writeln('Found --> '+MAPFILENAME);
if doserror<>0 then
begin
MAPFILENAME := 'gamemaps.sod';
filename := GAMEPATH + MAPFILENAME ;
findfirst(filename, $ff, search);
if doserror=0 then
writeln('Found --> '+MAPFILENAME);
if doserror<>0 then
begin
writeln('Error finding map file.');
writeln(' Read your documentation files.');
writeln;
writeln('Be sure that you installed MAPEDIT in the directory where');
writeln('Wolfenstein 3-D or Spear of Destiny is installed.');
halt(0);
end;
end;
end;
end;
end;
wl1 := false;
wl6 := false;
sod := false;
filename := search.name;
fsplit(filename, dir, name, ext);
MAPFILENAME := upper(MAPFILENAME);
if upper(ext)='.WL1' then
begin
LEVELS := 10;
if upper(name)='MAPTEMP'
then GAME_VERSION := 1.0
else GAME_VERSION := 1.1;
HEADFILENAME := 'maphead.wl1';
wl1 := true;
end;
if upper(ext)='.WL3' then
begin
LEVELS := 30;
GAME_VERSION :=1.1;
HEADFILENAME := 'maphead.wl3';
wl6 := true;
end;
if upper(ext)='.WL6' then
begin
LEVELS := 60;
GAME_VERSION := 1.1;
HEADFILENAME := 'maphead.wl6';
wl6 := true;
end;
if upper(ext)='.SOD' then
begin
LEVELS := 21;
GAME_VERSION := 1.1;
HEADFILENAME := 'maphead.sod';
sod := true;
end;
filename := GAMEPATH + HEADFILENAME ;
findfirst(filename, $ff, search);
if doserror=0 then
writeln('Found --> '+HEADFILENAME);
if doserror<>0 then
begin
writeln('Error finding MAPHEAD file -> '+ filename);
halt(0);
end;
map := 'mapdata.def' ;
obj := 'objdata.def' ;
findfirst(map, $ff, search);
if doserror=0 then
begin
writeln('Found --> '+map);
findfirst(obj, $ff, search);
if doserror=0 then
writeln('Found --> '+obj);
if doserror<>0 then
begin
writeln('Error finding --> '+obj);
halt(0);
end;
end;
if doserror<>0 then
begin
if wl1 then
begin
map := 'mapdata.wl1';
obj := 'objdata.wl1';
end;
if wl6 then
begin
map := 'mapdata.wl6';
obj := 'objdata.wl6';
end;
if sod then
begin
map := 'mapdata.sod';
obj := 'objdata.sod';
end;
findfirst(map, $ff, search);
if doserror=0 then
writeln('Found --> '+map);
if doserror<>0 then
begin
writeln('Error finding -->> '+map+ ' or mapdata.def.');
halt(0);
end;
findfirst(obj, $ff, search);
if doserror=0 then
writeln('Found --> '+obj);
if doserror <> 0 then
begin
writeln('Error finding --> '+obj);
halt(0);
end;
end;
if GAME_VERSION=1.0 then
begin
writeln('');
writeln('*** WARNING ***');
writeln('');
writeln('You are running a rather old version of Wolf-3D.');
writeln('');
writeln('This version supports only a limited number of map and object elements.');
writeln('');
writeln('You can upgrade to the latest shareware version at a nominal fee');
writeln('by calling Apogee. (You pay only shipping and handling.)');
writeln('');
writeln('');
writeln('(Press any key to continue)');
repeat until keypressed;
junk := readkey;
end;
for i:= 0 to 300 do
begin
mapnames[i] := 'unknown '+hex(i);
objnames[i] := 'unknown '+hex(i);
mapgraph[i] := 'f010';
objgraph[i] := 'f010';
legmapptr[i] := 0;
legobjptr[i] := 0;
end;
assign(infile, map);
reset(infile);
mapcount := -1;
while not eof(infile) do
begin
readln(infile, hexstr, junk, graphstr, junk, name20);
mapnames[str_to_hex(hexstr)] := name20;
mapgraph[str_to_hex(hexstr)] := graphstr;
mapcount := mapcount + 1;
legmapptr[mapcount] := str_to_hex(hexstr);
end;
close(infile);
assign(infile, obj);
reset(infile);
objcount := -1;
while not eof(infile) do
begin
readln(infile, hexstr, junk, graphstr, junk, name20);
objnames[str_to_hex(hexstr)] := name20;
objgraph[str_to_hex(hexstr)] := graphstr;
objcount := objcount + 1;
legobjptr[objcount] := str_to_hex(hexstr);
end;
close(infile);
end;
{-------------------------------------------------}
{ }
{VARs for procedure MAIN and associated procedures}
{ }
{-------------------------------------------------}
var gd,gm,
i,j,x,y : integer;
infile : text;
level : word;
oldx,oldy : integer;
done : boolean;
outstr,
tempstr : string;
legendpos : integer;
legendtype: integer;
newj : integer;
mode : (map,obj);
leftmapval : integer; {Value inserted by left button press - MAP mode}
rightmapval : integer; {Value inserted by right button press - MAP mode}
leftobjval : integer; {Value inserted by left button press - OBJ mode}
rightobjval : integer; {Value inserted by right button press - OBJ mode}
oldj,oldi : integer;
key : char;
control : boolean;
procedure showcurrentselection;
{
Removed from inside code body for 6.1 to allow use in
several places. Writes the little 'currently selected
attribute' note in the lower-left corner of the screen.
}
begin
setfillstyle(1,0);
bar(0, TEXTLOC+10, MAP_X+192, 479);
if mode=map then
begin
output(0, 66, mapgraph[leftmapval]);
outtext(1, 66, 15, ' '+mapnames[leftmapval]+' (MAP)');
end
else
begin
output(0, 66, objgraph[leftobjval]);
outtext(1, 66, 15, ' '+objnames[leftobjval]+' (OBJ)');
end;
end;
procedure process_buttons;
{
Added for 6.1 to facilitate easier handling of new functions.
}
label done;
begin
if (mem[0:keystataddr] and leftshiftmask>0) or
(mem[0:keystataddr] and rightshiftmask>0) then
{ User is holding down a shift key while clicking,
so let him/her load an atttribute from the map }
begin
if mouseloc.buttonstatus=leftbutton then {Load if left button}
if mode=map then
begin
leftmapval := levelmap[i,j]; {Load 'MAP' value}
showcurrentselection;
end
else
begin
leftobjval := objectmap[i,j]; {Load 'OBJ' value}
showcurrentselection;
end
else {Load if right button}
if mode=map then
rightmapval := levelmap[i,j] {Load 'MAP' value}
else
rightobjval := objectmap[i,j]; {Load 'OBJ' value}
goto done; {Leave procedure}
end;
{ Falls through to here is no shift key held down }
if mouseloc.buttonstatus=leftbutton then
if mode=map then {Draw if left button}
levelmap[i,j] := leftmapval
else
objectmap[i,j] := leftobjval
else {Draw if right button}
if mode=map then
levelmap[i,j] := rightmapval
else
objectmap[i,j] := rightobjval;
done: end;
procedure set_map_mode; {Broken out from code body - ver 6.1}
begin;
wait_for_mouserelease;
legendpos := 0;
legendtype := 0;
mode := map;
showlegend(legendtype, legendpos, 25);
showcurrentselection;
end;
procedure set_object_mode; {Broken out from code body - ver 6.1}
begin
wait_for_mouserelease;
legendpos := 0;
legendtype := 1;
mode := obj;
showlegend(legendtype, legendpos, 25);
showcurrentselection;
end;
procedure legend_up; {Broken out from code body - ver 6.1}
begin
wait_for_mouserelease;
dec(legendpos, 25);
if legendpos<0 then legendpos := 0;
showlegend(legendtype, legendpos, 25);
end;
procedure legend_down; {Broken out from code body - ver 6.1}
begin
wait_for_mouserelease;
inc(legendpos, 25);
if legendtype=0 then
begin
if (legendpos+25)>mapcount then legendpos := mapcount-24;
end
else
if (legendpos+25)>objcount then legendpos := objcount-24;
showlegend(legendtype, legendpos, 25);
end;
{----------------------}
{ }
{ MAIN CODE BODY }
{ }
{----------------------}
begin
clrscr;
initialize;
directvideo := false;
read_levels;
gd := vga;
gm := vgahi;
initgraph(gd, gm, '');
settextstyle(0,0,1);
mreset(themouse);
show_objects := true;
show_floor := false;
guards_1 := false;
guards_3 := false;
guards_4 := false;
guards_s := false;
treasure := false;
ammofood := false;
stats := false;
copy := false;
excng := false;
xfer := false;
x := port[$3da];
port[$3c0] := 0;
setfillstyle(1,7);
bar(0, 0, MAP_X+452, MAP_Y+452);
bar(MAP_X+457, 0, 639, 380);
setfillstyle(1,0);
bar(2, 2, MAP_X+450, MAP_Y+450);
bar(MAP_X+459, 2, 637, 352);
bar(MAP_X+459, 355,637, 378);
setcolor(15);
outtextxy(MAP_X+463, 364, ' MAP OBJ UP DOWN');
setfillstyle(1,7);
bar(MAP_X+502, 355, MAP_X+503, 378);
bar(MAP_X+542, 355, MAP_X+543, 378);
bar(MAP_X+572, 355, MAP_X+573, 378);
legendpos := 0;
legendtype := 0;
mode := map;
leftmapval :=1; {Default values for buttons - ver 6.1}
rightmapval :=0;
leftobjval :=0;
rightobjval :=0;
setfillstyle(1,0);
bar(0, TEXTLOC+10, MAP_X+448, 479);
if mode=map then
begin
output(0, 66, mapgraph[leftmapval]);
outtext(1, 66, 15, ' '+mapnames[leftmapval]);
end
else
begin
output(0, 66, objgraph[leftmapval]);
outtext(1, 66, 15, ' '+objnames[leftmapval]);
end;
showlegend(legendtype, legendpos, 25);
x := port[$3da];
port[$3c0] := 32;
mshow;
level :=1;
done := false;
setfillstyle(1,0);
setcolor(15);
print_help;
print_version;
showcurrentselection;
{-------------}
{ }
{ Main Loop }
{ }
{-------------}
repeat
mhide;
setfillstyle(1,0);
bar(0, TEXTLOC, MAP_X+173 , TEXTLOC+9);
setcolor(14);
outtextxy(5, TEXTLOC, maps[level].name);
setcolor(15);
expand(maps[level].map, levelmap);
expand(maps[level].objects, objectmap);
display_map;
print_stats;
mshow;
oldx := 0;
oldy := 0;
key := #0;
repeat
repeat
mpos(mouseloc);
x := mouseloc.column;
y := mouseloc.row;
until (oldx<>x) or (oldy<>y) or keypressed or (mouseloc.buttonstatus<>0);
oldx := x;
oldy := y;
if (mouseloc.buttonstatus<>0) then {Mouse Button Pressed}
begin
if inside(MAP_X, MAP_Y, MAP_X+447, MAP_Y+447, x, y) then
begin { If inside the map display }
mhide;
repeat
i := (x-MAP_X) div 7;
j := (y-MAP_Y) div 7;
process_buttons; {Rev 6.1}
setfillstyle(1,0);
dobar(i*7, j*7, i*7+6, j*7+6);
if show_floor then
output(i, j, mapgraph[levelmap[i,j]])
else
if not (levelmap[i,j] in [$6a..$8f]) then
output(i, j, mapgraph[levelmap[i,j]]);
if show_objects then
output(i, j, objgraph[objectmap[i,j]]);
mpos(mouseloc);
x := mouseloc.column;
y := mouseloc.row;
until (not inside(MAP_X, MAP_Y, MAP_X+447, MAP_Y+447, x, y)) or
(mouseloc.buttonstatus=0);
mshow;
print_stats;
end;
if inside(464, 355, 506, 378, x, y) then
set_map_mode; {Inside MAP command box}
if inside(509, 355, 546, 378, x, y) then
set_object_mode; {Inside OBJ command box}
if inside(549, 355, 576, 378, x, y) then
legend_up; {Inside UP command box}
if inside(579, 355, 637, 378, x, y) then
legend_down; {Inside DOWN command box}
end;
if inside(464, 2, 637, 350, x, y) then
begin { If inside the legend box }
mhide;
j := (y-2) div 14;
setcolor(15);
rectangle(465, j*14+3, 636, j*14+14);
repeat
mpos(mouseloc);
newj := (mouseloc.row-2) div 14;
if mouseloc.buttonstatus<>0 then
begin { Set current value based on button pressed - ver 6.1 }
if mode=map then
if mouseloc.buttonstatus=leftbutton then
leftmapval := legmapptr[legendpos+j]
else
rightmapval := legmapptr[legendpos+j]
else
if mouseloc.buttonstatus=leftbutton then
leftobjval := legobjptr[legendpos+j]
else
rightobjval := legobjptr[legendpos+j];
showcurrentselection;
end;
until (newj<>j) or (mouseloc.column<464) or keypressed;
setcolor(0);
rectangle(465, j*14+3, 636, j*14+14);
mshow;
end;
if inside(MAP_X, MAP_Y, MAP_X+447, MAP_Y+447, x, y) then
begin { If inside the map display }
i := (x-MAP_X) div 7;
j := (y-MAP_Y) div 7;
if (oldj<>j) or (oldi<>i) then
begin
outstr := '(';
str(i:2, tempstr);
outstr := outstr+tempstr+',';
str(j:2, tempstr);
outstr := outstr+tempstr+') MAP: '+mapnames[levelmap[i,j]];
setfillstyle(1,0);
setcolor(15);
bar(188, TEXTLOC, MAP_X+448, 479);
outtextxy(188, TEXTLOC, outstr);
outstr := ' OBJ: '+objnames[objectmap[i,j]];
outtextxy(188, TEXTLOC+10, outstr);
oldj := j;
oldi := i;
end;
end
else
begin
mhide;
setfillstyle(1,0);
bar(188, TEXTLOC, MAP_X+448, 479);
mshow;
end;
if keypressed then
begin
control := false;
key := readkey;
if key=#0 then
begin
control := true;
key := readkey;
end;
if control then
case key of
'H': begin
freemem(maps[level].map.data, maps[level].map.size);
freemem(maps[level].objects.data, maps[level].objects.size);
compress(levelmap, maps[level].map);
compress(objectmap, maps[level].objects);
inc(level);
end;
'P': begin
freemem(maps[level].map.data, maps[level].map.size);
freemem(maps[level].objects.data, maps[level].objects.size);
compress(levelmap, maps[level].map);
compress(objectmap, maps[level].objects);
dec(level);
end;
{keyboard support - ver 6.1}
key_pgup : legend_up;
key_pgdn : legend_down;
end
else
case key of
'q','Q': begin
done := true;
freemem(maps[level].map.data, maps[level].map.size);
freemem(maps[level].objects.data, maps[level].objects.size);
compress(levelmap, maps[level].map);
compress(objectmap, maps[level].objects);
end;
'c','C': begin
if mode = map then clear_level(leftmapval)
else clear_level($6c);
end;
'o','O': begin
mhide;
show_objects := not show_objects;
display_map;
mshow;
end;
'f','F': begin
mhide;
show_floor := not show_floor;
display_map;
if legendtype=0 then
showlegend(legendtype,legendpos,25);
mshow;
end;
'1': begin
mhide;
show_objects := true;
guards_1 := true;
guards_3 := false;
guards_4 := false;
guards_s := false;
treasure := false;
ammofood := false;
stats := true;
display_map;
print_stats;
mshow;
end;
'2': begin
mhide;
show_objects := true;
guards_1 := false;
guards_3 := false;
guards_4 := false;
guards_s := false;
treasure := true;
ammofood := false;
stats := true;
display_map;
print_stats;
mshow;
end;
'3': begin
mhide;
show_objects := true;
guards_1 := false;
guards_3 := true;
guards_4 := false;
guards_s := false;
treasure := false;
ammofood := false;
stats := true;
display_map;
print_stats;
mshow;
end;
'4': begin
mhide;
show_objects := true;
guards_1 := false;
guards_3 := false;
guards_4 := true;
guards_s := false;
treasure := false;
ammofood := false;
stats := true;
display_map;
print_stats;
mshow;
end;
'5': begin
mhide;
show_objects := true;
guards_1 := false;
guards_3 := false;
guards_4 := false;
guards_s := true;
treasure := false;
ammofood := false;
stats := true;
display_map;
print_stats;
mshow;
end;
'6': begin
mhide;
show_objects := true;
guards_1 := false;
guards_3 := false;
guards_4 := false;
guards_s := false;
treasure := false;
ammofood := true;
stats := true;
display_map;
print_stats;
mshow;
end;
'A','a': begin
mhide;
show_objects := true;
guards_1 := false;
guards_3 := false;
guards_4 := false;
guards_s := false;
treasure := false;
ammofood := false;
display_map;
print_stats;
mshow;
end;
's','S': begin
mhide;
if (guards_1 or guards_3 or guards_4 or
guards_s or treasure or ammofood) then
begin
guards_1 := false;
guards_3 := false;
guards_4 := false;
guards_s := false;
treasure := false;
ammofood := false;
display_map;
end;
stats := not stats;
if stats then print_stats
else print_help;
mshow;
end;
'm','M': begin
copy := true;
print_help;
copy_level;
if stats then print_stats;
end;
'e','E': begin
mhide;
excng := true;
print_help;
if copy then
begin
exchange;
display_map;
end;
excng := false;
print_help;
if stats then print_stats;
mshow;
end;
't','T': begin
mhide;
xfer := true;
print_help;
if copy then
begin
paste_level;
display_map;
end;
xfer := false;
print_help;
delay(200);
if stats then print_stats;
mshow;
end;
'r','R': begin
mhide;
setfillstyle(1,0);
bar(180, TEXTLOC, 461, 479);
setcolor(15);
outtextxy(180, TEXTLOC, 'Reading Floor File');
read_floor;
setfillstyle(1,0);
bar(180, TEXTLOC, 461, 479);
if stats then print_stats;
mshow;
end;
'w','W': begin
mhide;
setfillstyle(1,0);
bar(180, TEXTLOC, 461, 479);
setcolor(15);
outtextxy(180, TEXTLOC, 'Writing Floor File');
write_floor;
setfillstyle(1,0);
bar(180,TEXTLOC,461,479);
mshow;
end;
'v','V': begin
print_version;
end;
' ' : begin {Space toggles mode MAP<->OBJ - ver 6.1}
if mode=map then
set_object_mode
else
set_map_mode;
end;
end;
end;
until done or (key in ['P','H']);
if level=0 then level := LEVELS;
if level=(LEVELS+1) then level := 1;
until done;
setfillstyle(1,0);
bar(0, TEXTLOC, 462, 479);
setcolor(15);
outtextxy(0, TEXTLOC,' Save the current levels to disk? (Y/N) ');
repeat
repeat until keypressed;
key := readkey;
if key=#0 then
begin
key := readkey;
key := #0;
end;
until key in ['y','Y','n','N'];
if key in ['y','Y'] then write_levels;
textmode(co80);
writeln('MapEdit 4.1 Copyright (c) 1992 Bill Kirby');
writeln;
writeln(' Ver. '+VERSION+' Modification');
writeln;
writeln('This program is intended to be for your personal use only.');
writeln('Distribution of any modified maps may be construed as a ');
writeln('copyright violation by Apogee/ID.');
writeln;
end.